home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / editnew / EDITNEW.ZIP / EDITNEW.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-25  |  24KB  |  750 lines
  1. {TEditN, TMEditN, TDBEditN
  2.  
  3.  - Author   : Jose Maria Gias
  4.  - email    : sigecom@arrakis.es
  5.  - Version  : 2.1  Delphi 2-3
  6.  - Date     : 26.05.98
  7.  - Type     : FreeWare
  8.  
  9.  Comments in file ReadENew.Txt
  10.  }
  11. unit EditNew;
  12.  
  13. interface
  14.  
  15. uses
  16.   {$IFDEF WIN32}Windows,{$ELSE}Winprocs,{$ENDIF}
  17.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  18.   StdCtrls, Mask, DBCtrls;
  19.  
  20. type
  21.   TEditTypes = (etString, etInteger, etFloat,etDate,etTime);
  22.   TEditAlign = (etAlignRight, etAlignLeft, etAlignCenter, etAlignNone, etAlignValue);
  23.  
  24.   TEditN = class(TEdit)
  25.   private
  26.     { Private declarations }
  27.     FOnEnter      : TNotifyEvent;
  28.     FOnExit       : TNotifyEvent;
  29.     FOnChange     : TNotifyEvent;
  30.     I_Color       : TColor;
  31.     E_Color       : TColor;
  32.     FI_Color      : TColor;
  33.     FE_Color      : TColor;
  34.     TipoEdit      : TEditTypes;
  35.     TipoAlign     : TEditAlign;
  36.     KeyTab        : Char;
  37.     LongAlign     : Integer;
  38.     ValInteger    : Integer;
  39.     ValFloat      : Double;
  40.     SDecimal      : Char;
  41.     EPrecision    : Integer;
  42.     FUpper        : Boolean;
  43.     FUpperList    : String;
  44.     ValTemp       : Extended;
  45.     TxtConvert    : String;
  46.     FWidthOnFocus : Integer;
  47.     iWidth        : Integer;
  48.     TextAtEnter   : String;
  49.     PtrToData     : Pointer;
  50.     sDate         : Char;
  51.     sTime         : Char;
  52.     FSeconds      : Boolean;
  53.     ValDate       : TDateTime;
  54.     ValTime       : TDateTime;
  55.   protected
  56.     {Protected declarations}
  57.     procedure FormatDate;
  58.     procedure FormatTime;
  59.   public
  60.     procedure KeyPress(var Key: Char); override;
  61.     procedure DoEnter; override;
  62.     procedure DoExit; override;
  63.     procedure Change; override;
  64.     procedure SetInteger(VInteger : Integer);
  65.     procedure SetFloat(VFloat : Double);
  66.     procedure SetPtrToData(DataPtr:Pointer);
  67.     procedure Update; // Not declare override because make stack overflow
  68.     constructor Create(AOwner : TComponent); override;
  69.   published
  70.     property  OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
  71.     property  OnExit : TNotifyEvent read FOnExit  write FOnExit;
  72.     property  OnChange : TNotifyEvent read FOnChange  write FOnChange;
  73.     property  ColorOnFocus : TColor read I_Color write I_Color;
  74.     property  ColorOnNotFocus : TColor read E_Color write E_Color;
  75.     property  FontColorOnFocus : TColor read FI_Color write FI_Color;
  76.     property  FontColorOnNotFocus : TColor read FE_Color write FE_Color;
  77.     property  EditType : TEditTypes read TipoEdit write TipoEdit;
  78.     property  EditKeyByTab : Char read KeyTab write KeyTab;
  79.     property  EditAlign : TEditAlign read TipoAlign write TipoAlign;
  80.     property  EditLengthAlign : Integer read LongAlign write LongAlign;
  81.     property  EditPrecision : Integer read EPrecision write EPrecision;
  82.     property  ValueFloat : Double read ValFloat write ValFloat;
  83.     property  ValueInteger : Integer read ValInteger write ValInteger;
  84.     property  ValueDate : TDateTime read ValDate write ValDate;
  85.     property  ValueTime : TDateTime read ValTime write ValTime;
  86.     property  TimeSeconds : Boolean read FSeconds write FSeconds;
  87.     property  FirstCharUpper : Boolean read FUpper write FUpper;
  88.     property  FirstCharUpList : String read FUpperList write FUpperList;
  89.     property  WidthOnFocus : Integer read FWidthOnFocus write FWidthOnFocus;
  90.   end;
  91.  
  92. type
  93.   TMEditN = class(TMaskEdit)
  94.   private
  95.     { Private declarations }
  96.     FOnEnter      : TNotifyEvent;
  97.     FOnExit       : TNotifyEvent;
  98.     I_Color       : TColor;
  99.     E_Color       : TColor;
  100.     FI_Color      : TColor;
  101.     FE_Color      : TColor;
  102.     FKeyTab       : Char;
  103.     FWidthOnFocus : Integer;
  104.     iWidth        : Integer;
  105.   protected
  106.     { Protected declarations }
  107.   public
  108.     { Public declarations }
  109.     procedure KeyPress(var Key: Char); override;
  110.     procedure DOEnter; override;
  111.     procedure DOExit ; override;
  112.     constructor Create(AOwner : TComponent); override;
  113.   published
  114.     { Published declarations }
  115.     property  OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
  116.     property  OnExit : TNotifyEvent read FOnExit  write FOnExit;
  117.     property  ColorOnFocus : TColor read I_Color write I_Color;
  118.     property  ColorOnNotFocus : TColor read E_Color write E_Color;
  119.     property  FontColorOnFocus : TColor read FI_Color write FI_Color;
  120.     property  FontColorOnNotFocus : TColor read FE_Color write FE_Color;
  121.     property  EditKeyByTab : Char read FKeyTab write FKeyTab;
  122.     property  WidthOnFocus : Integer read FWidthOnFocus write FWidthOnFocus;
  123.   end;
  124.  
  125. type
  126.   TDBEditN = class(TDBEdit)
  127.   private
  128.     { Private declarations }
  129.     FOnEnter      : TNotifyEvent;
  130.     FOnExit       : TNotifyEvent;
  131.     I_Color       : TColor;
  132.     E_Color       : TColor;
  133.     FI_Color      : TColor;
  134.     FE_Color      : TColor;
  135.     FKeyTab       : Char;
  136.     FWidthOnFocus : Integer;
  137.     iWidth        : Integer;
  138.     FUpper        : Boolean;
  139.     FUpperList    : String;
  140.   protected
  141.     { Protected declarations }
  142.   public
  143.     { Public declarations }
  144.     procedure KeyPress(var Key: Char); override;
  145.     procedure DOEnter; override;
  146.     procedure DOExit ; override;
  147.     constructor Create(AOwner : TComponent); override;
  148.   published
  149.     { Published declarations }
  150.     property  OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
  151.     property  OnExit : TNotifyEvent read FOnExit  write FOnExit;
  152.     property  ColorOnFocus : TColor read I_Color write I_Color;
  153.     property  ColorOnNotFocus : TColor read E_Color write E_Color;
  154.     property  FontColorOnFocus : TColor read FI_Color write FI_Color;
  155.     property  FontColorOnNotFocus : TColor read FE_Color write FE_Color;
  156.     property  EditKeyByTab : Char read FKeyTab write FKeyTab;
  157.     property  FirstCharUpper : Boolean read FUpper write FUpper;
  158.     property  FirstCharUpList : String read FUpperList write FUpperList;
  159.     property  WidthOnFocus : Integer read FWidthOnFocus write FWidthOnFocus;
  160.   end;
  161.  
  162. procedure Register;
  163.  
  164. implementation
  165.  
  166. {$R EdNew32.res}
  167.  
  168. constructor TEditN.Create(AOwner : TComponent);
  169. begin
  170.   inherited Create(AOwner);
  171.   ColorOnFocus        := clWhite;
  172.   ColorOnNotFocus     := clSilver;
  173.   Color               := ColorOnNotFocus;
  174.   FontColorOnFocus    := clRed;
  175.   FontColorOnNotFocus := clBlack;
  176.   TipoEdit            := etString;
  177.   TipoAlign           := etAlignNone;
  178.   LongAlign           := 0;
  179.   KeyTab              := #9;        // #13 for Return by Tab
  180.   ValInteger          := 0;
  181.   ValFloat            := 0;
  182.   EPrecision          := 0;
  183.   SDecimal            := DecimalSeparator;
  184.   FUpper              := False;
  185.   FUpperList          := ' (';
  186.   FWidthOnFocus       := 0;
  187.   TextAtEnter         := '';
  188.   PtrToData           := nil;
  189.   sDate               := DateSeparator;   // Windows Default
  190.   sTime               := TimeSeparator;   // Windows Default
  191.   FSeconds            := False;           // etTime with seconds
  192.   ValDate             := Date;
  193.   ValTime             := Time;
  194. end;
  195.  
  196. procedure TEditN.SetPtrToData(DataPtr:Pointer);
  197. begin
  198.  PtrToData := DataPtr;
  199.  Update;
  200. end;
  201.  
  202. procedure TEditN.Update;
  203. begin
  204.  if Assigned(PtrToData) then begin
  205.   if EditType = etString  then Text := string(PtrToData^);
  206.   if EditType = etInteger then Text := IntToStr(Integer(PtrToData^));
  207.   if EditType = etFloat   then Text := FloatToStrF(Double(PtrToData^),ffgeneral,15,4);
  208.   if EditType = etDate    then Text := DateToStr(TDateTime(PtrToData^));
  209.   if EditType = etTime    then Text := TimeToStr(TDateTime(PtrToData^));
  210.  end;
  211.  Refresh;
  212.  inherited Update;
  213. end;
  214.  
  215. procedure TEditN.KeyPress(var Key: Char);
  216. var
  217.  {$IFDEF VER100}
  218.   FEditTemp : TCustomForm; {For Delphi 3}
  219.  {$ELSE}
  220.   FEditTemp : TForm;       {For Delphi 1 - 2}
  221.  {$ENDIF}
  222.  C         : String;
  223. begin
  224.  
  225.  if Key = EditKeyByTab then begin
  226.   FEditTemp := GetParentForm(Self);
  227.   SendMessage(FEditTemp.Handle, WM_NEXTDLGCTL, 0, 0);
  228.   Key := #0;
  229.  end else begin
  230.  
  231.   // If ESC is pressed during edit, all changes are cancelled
  232.   // Si se ha pulsado escape, se anulan los cambios
  233.   if Key = #27 then begin
  234.    Text := TextAtEnter;
  235.    Key  := #15;
  236.   end;
  237.  
  238.   //Permitted characters in function of type
  239.   // Caracteres permitidos en funci≤n del tipo
  240.   Case EditType of
  241.    etString :
  242.     if FUpper then begin // Capital letter  - Ma²usculas
  243.      if (Length(Text) = 0) or
  244.         (SelText = Text) or
  245.         (Pos(Text[Length(Text)],FUpperList) > 0) then begin
  246.       C   := AnsiUpperCase(Key);
  247.       Key := C[1];
  248.      end;
  249.     end;
  250.  
  251.    etInteger :
  252.     begin
  253.      if ((Pos('-',Text) > 0) or (Key = '-')) and (MaxLength = 0)
  254.       then MaxLength := 11;
  255.  
  256.      if (not (Key in ['0'..'9','-',#8,#13,#35,#36,#37,#39])) or
  257.         (Key = #32) or // To eliminate the introduction from spaces
  258.         ((Key = '-') and (Pos('-',Text) > 0)) // To verify that alone is introduce a negative sign.
  259.       then Key := #15;
  260.  
  261.     end;
  262.  
  263.    etFloat :
  264.     begin
  265.      if (not (Key in ['0'..'9',',','.','-',#8,#13,#35,#36,#37,#39])) or
  266.         (Key = #32) or // To eliminate the spaces introduction
  267.         ((Key = '-') and (Pos('-',Text) > 0)) // To verify that alone is introduce a negative sign.
  268.       then Key := #15;
  269.  
  270.      if (Key = ',') or (Key = '.') then
  271.       if (Pos(',',Text) > 0) or (Pos('.',Text) > 0)
  272.        then Key := #15
  273.        else Key := DecimalSeparator;
  274.  
  275.     end;
  276.  
  277.    etDate, etTime :
  278.     if not (Key in ['0'..'9',#8,#13,#35,#36,#37,#39])
  279.      then Key := #15;
  280.  
  281.   end; // Case EditType of
  282.  end;  // if Key <> EditKeyByTab
  283.  
  284.  if Key <> #0 then inherited KeyPress(Key);
  285.  
  286. end;
  287.  
  288. procedure TEditN.DoEnter;
  289. begin
  290.  // To assign the Color upon receiving the focus
  291.  if (EditType = etFloat) and (MaxLength = 0) then MaxLength := 16;
  292.  Color       := ColorOnFocus;
  293.  Font.Color  := FontColorOnFocus;
  294.  TextAtEnter := Text;
  295.  
  296.  if WidthOnFocus > 0 then begin
  297.   iWidth := Width;
  298.   Width  := FWidthOnFocus;
  299.  end;
  300.  
  301.  // If a connection to a variable exists, Update the contents of the field with
  302.  // the contents of the connected variable in case the variable has changed.
  303.  if Assigned(PtrToData) then Update;
  304.  
  305.  if EditType = etDate then MaxLength := 10;
  306.  
  307.  if EditType = etTime then
  308.   if TimeSeconds then MaxLength := 8
  309.                  else MaxLength := 5;
  310.  
  311.  if Assigned(FOnEnter) then FOnEnter(Self);
  312. end;
  313.  
  314. procedure TEditN.DoExit;
  315. var
  316.  k : Integer;
  317.  s : String;
  318. begin
  319.  
  320.  // To return the color of the fund upon leaving and losing the focus
  321.  Color      := ColorOnNotFocus;
  322.  Font.Color := FontColorOnNotFocus;
  323.  
  324.  if WidthOnFocus > 0 then Width := iWidth;
  325.  
  326.  if (EditType = etString) and (Length(Text) > 0) then begin
  327.  
  328.   if FUpper then begin
  329.    if Length(Text) = 1 then Text := AnsiUpperCase(Text);
  330.    if Length(Text) > 1 then Text := AnsiUpperCase(Text[1]) + Copy(Text,2,Length(Text)-1);
  331.   end;
  332.  
  333.   if (EditAlign <> etAlignNone) and (EditLengthAlign > 0) then begin // With Alignment
  334.  
  335.    // The length of the chain is < that that of Align.
  336.    if (EditLengthAlign > Length(Text)) then
  337.     Case EditAlign of
  338.      etAlignLeft  :
  339.       begin
  340.        while Text[1] = ' ' do Text := Copy(Text,2,Length(Text)-1);
  341.        for k := 1 to EditLengthAlign - Length(Text) do Text := Text + ' ';
  342.       end;
  343.  
  344.      etAlignRight :
  345.       begin
  346.        for k:= 1 to EditLengthAlign - Length(Text) do Text := ' ' + Text;
  347.       end;
  348.  
  349.      etAlignCenter:
  350.       begin
  351.        for k := 1 to Round((EditLengthAlign - Length(Text))/2) do Text := ' ' + Text;
  352.        for k := Length(Text) to EditLengthAlign do Text := Text + ' ';
  353.       end;
  354.  
  355.     end; // Case EditAlign
  356.   end; // if (EditLengthAlign > Length(Text))
  357.  end; // if (EditAlign <> etAlignNone) and (EditLengthAlign > 0)
  358.  
  359.  // To align a string Integer, filling with zeroes, if it has been indicated.
  360.  // The negative sign if exists, counts it as a digit but
  361.  if (EditType = etInteger) and
  362.     (EditAlign = etAlignValue) and
  363.     (EditLengthAlign > 0) then
  364.   if Length(Text) < EditLengthAlign then
  365.    for k := Length(Text) to EditLengthAlign - 1 do Text := '0' + Text;
  366.  
  367.  // To put the negative sign to the beginning of the chain. It has been designed
  368.  // so that the negative sign could be introduced in any place, and here we happen
  369.  // it to the beginning
  370.  if ((EditType = etInteger) or (EditType = etFloat)) and (Pos('-',Text) > 1) then
  371.   if Length(Text) = Pos('-',Text)
  372.    then Text := '-' + Copy(Text,1,Pos('-',Text)-1)
  373.    else Text := '-' +
  374.                 Copy(Text,1,Pos('-',Text)-1) +
  375.                 Copy(Text,Pos('-',Text) + 1,Length(Text) - Pos('-',Text));
  376.  
  377.  // If it has been defined precision, gives format  to the string
  378.  if (EditType = etFloat) and (EditPrecision > 0) then begin
  379.   if Length(Text) = 0 then Text := '0';
  380.   SDecimal := DecimalSeparator;
  381.   if Pos(SDecimal,Text) = 0 then begin
  382.    Text := Text + SDecimal;
  383.    for k := 1 to EditPrecision do Text := Text + '0';
  384.   end else begin
  385.    if Length(Text) - Pos(SDecimal,Text) > EditPrecision then
  386.     Text := Copy(Text,1,Pos(SDecimal,Text) + EditPrecision);
  387.    if Length(Text) - Pos(SDecimal,Text) < EditPrecision then
  388.     for k := Length(Text) - Pos(SDecimal,Text) + 1 to EditPrecision do Text := Text + '0';
  389.   end;
  390.  end;
  391.  
  392.  // To align a string Float, filling of zeroes, if it has been indicated.
  393.  // The negative sign if exists and the separating decimal, the account as a digit but
  394.  if (EditType = etFloat) and
  395.     (EditAlign = etAlignValue) and
  396.     (EditLengthAlign > 0) then
  397.   if Length(Text) < EditLengthAlign then
  398.    for k := Length(Text) to EditLengthAlign - 1 do Text := '0' + Text;
  399.  
  400.  if EditType = etDate then FormatDate;
  401.  
  402.  if EditType = etTime then FormatTime;
  403.  
  404.  // Update the connected variable with the current value
  405.  if Assigned(PtrToData) then begin
  406.   if EditType = etInteger then Move(ValueInteger, PtrToData^, Sizeof(ValueInteger));
  407.   if EditType = etFloat   then Move(ValueFloat,   PtrToData^, Sizeof(ValueFloat));
  408.   if EditType = etDate    then Move(ValueDate,    PtrToData^, Sizeof(ValueDate));
  409.   if EditType = etTime    then Move(ValueTime,    PtrToData^, Sizeof(ValueTime));
  410.   if EditType = etString  then begin
  411.    s := Text;
  412.    Move(s, PtrToData^, Sizeof(s));
  413.   end;
  414.  end;
  415.  
  416.  if Assigned(FOnExit) then FOnExit(Self);
  417. end;
  418.  
  419. procedure TEditN.Change;
  420. var
  421.  i : Integer;
  422.  C : String;
  423. begin
  424.  // To convert the chain if it is numerical,to return a value
  425.  if ((EditType = etInteger) or (EditType = etFloat)) and
  426.     (Length(Text) > 0) then begin
  427.  
  428.   if EditType = etInteger then begin
  429.    for i := 1 to Length(Text) do begin
  430.     if Text[i] in ['0'..'9','-','+'] then C := C + Text[i]
  431.    end;
  432.    Text := C;
  433.   end;
  434.  
  435.   if EditType = etFloat then begin
  436.    for i := 1 to Length(Text) do begin
  437.     if Text[i] in ['0'..'9',',','.','-','+'] then C := C + Text[i]
  438.    end;
  439.    Text := C;
  440.   end;
  441.  
  442.   if Length(Text) = 0 then begin
  443.    if Assigned(FOnChange) then FOnChange(Self);
  444.    Exit;
  445.   end;
  446.  
  447.   try
  448.    ValueFloat   := 0;
  449.    ValueInteger := 0;
  450.  
  451.    // Eliminar caracteres no permitidos y cambiar el signo - al comienzo para
  452.    //  que no de error de conversi≤n
  453.    i := 1;
  454.    while i <= Length(Text) do
  455.     if not (Text[i] in ['0'..'9',',','.','-'])
  456.      then Text := Copy(Text,1,i-1) + Copy(Text,i+1,Length(Text)-i)
  457.      else i := i + 1;
  458.  
  459.    // Si solo tenemos el signo negativo, darφa error
  460.    if (Pos('-',Text) = 1) and (Length(Text) = 1) then Exit;
  461.  
  462.    // Temporary variable to accomplish the conversion
  463.    TxtConvert := Text;
  464.  
  465.    // To put the negative sign to the beginning
  466.    if (EditType <> etString) and (Pos('-',TxtConvert) > 1) then
  467.     if Length(TxtConvert) = Pos('-',TxtConvert)
  468.      then TxtConvert := '-' + Copy(TxtConvert,1,Pos('-',TxtConvert)-1)
  469.      else TxtConvert := '-' +
  470.                         Copy(TxtConvert,1,Pos('-',TxtConvert)-1) +
  471.                         Copy(TxtConvert,Pos('-',TxtConvert) + 1,Length(TxtConvert) - Pos('-',TxtConvert));
  472.  
  473.    if EditType = etInteger then begin
  474.     // Range control of Integer
  475.     ValTemp := StrToFloat(TxtConvert);
  476.     if (ValTemp > 2147483647) or (ValTemp < -2147483647) then begin
  477.      ShowMessage('Range Max. : -2147483647 <-> 2147483647');
  478.      ValueInteger := 0;
  479.     end else begin
  480.      ValueInteger := StrToInt(TxtConvert);
  481.      ValueFloat   := StrToFloat(TxtConvert + sDecimal + '0'); {New in Version 2.0}
  482.     end;
  483.    end;
  484.  
  485.    // El tipo Float - Double, permite valores hasta 5.0 * 10e-324 .. 1.7 * 10e308
  486.    // con 15-16 digitos significativos, por lo que solamente controlamos que el total
  487.    // no pase de 16 digitos. Hasta la fecha no he experimentado con valores Float tan
  488.    // altos, por lo que no me atrevo a condicionar algo que no conozco con exactitud.}
  489.    if EditType = etFloat then begin
  490.     ValueFloat   := StrToFloat(TxtConvert);
  491.     ValueInteger := Trunc(ValueFloat);
  492.    end;
  493.  
  494.   except
  495.    on EConvertError do begin
  496.      ShowMessage('Range Max. :' + #13 +
  497.                  ' - Integer : -2147483647 <-> 2147483647' + #13 +
  498.                  ' - Float   : 5.0e-324 <-> 1.7e+308');
  499.      ValueInteger := 0;
  500.      ValueFloat   := 0;
  501.    end;
  502.   end;
  503.  end;
  504.  
  505.  if Assigned(FOnChange) then FOnChange(Self);
  506. end;
  507.  
  508. procedure TEditN.SetInteger(VInteger : Integer);
  509. begin
  510.  if EditType = etInteger then Text := IntToStr(VInteger);
  511. end;
  512.  
  513. procedure TEditN.SetFloat(VFloat : Double);
  514. begin
  515.  if EditType = etFloat then Text := FloatToStr(VFloat);
  516. end;
  517.  
  518. procedure TEditN.FormatDate;
  519. var
  520.  Temp,vDate,vMonth,vYear : String;
  521.  dDate   : TDateTime;
  522.  ilength : Integer;
  523. begin
  524.  // Decode the Date
  525.  Temp    := '';
  526.  vDate   := FormatDateTime('dd' + sDate + 'mm' + sDate + 'yyyy',Date);
  527.  vMonth  := Copy(vDate,4,2);
  528.  vYear   := Copy(vDate,7,4);
  529.  
  530.  // Quitar separador de fecha si existe
  531.  if Length(Text) > 0 then
  532.   for iLength := 1 to Length(Text) do
  533.    if Text[iLength] in ['0'..'9']
  534.     then Temp := Temp + Text[iLength];
  535.  
  536.  // Completar la fecha con separadores
  537.  iLength := Length(Temp);
  538.  Case iLength of
  539.   0 : Temp := vDate;
  540.   1 : Temp := '0' + Temp[1] + sDate + vMonth + sDate + vYear;
  541.   2 : Temp := Temp + sDate + vMonth + sDate + vYear;
  542.   3 : Temp := Copy(Temp,1,2) + sDate + '0' + Temp[3] + sDate + vYear;
  543.   4 : Temp := Copy(Temp,1,2) + sDate + Copy(Temp,3,2) + sDate + vYear;
  544.   5 : Temp := Copy(Temp,1,2) + sDate + Copy(Temp,3,2) + sDate + Copy(vYear,1,3) + Temp[5];
  545.   6 : Temp := Copy(Temp,1,2) + sDate + Copy(Temp,3,2) + sDate + Copy(vYear,1,2) + Copy(Temp,5,2);
  546.   7 : Temp := Copy(Temp,1,2) + sDate + Copy(Temp,3,2) + sDate + vYear[1] + Copy(Temp,5,3);
  547.   8,9,10 : Temp := Copy(Temp,1,2) + sDate + Copy(Temp,3,2) + sDate + Copy(Temp,5,4);
  548.  end;
  549.  
  550.  // Test of correct Date
  551.  try
  552.   dDate := StrToDate(Temp);
  553.  except
  554.   ShowMessage('Date incorrect');
  555.   // On error, the Date is actually for default
  556.   ValueDate    := Date;
  557.   ValueFloat   := Date; // TDateTime : Double;
  558.   ValueInteger := Trunc(Date);
  559.   Exit;
  560.  end;
  561.  
  562.  // The Date is correct. Assign value
  563.  Text         := Temp;
  564.  ValueDate    := StrToDate(Temp);
  565.  ValueFloat   := ValueDate; // TDateTime : Double;
  566.  ValueInteger := Trunc(ValueDate);
  567. end;
  568.  
  569. procedure TEditN.FormatTime;
  570. var
  571.  Temp,vTime,vMin,vSec,MskTime : String;
  572.  iLength : Integer;
  573.  tTime   : TDateTime;
  574. begin
  575.  Temp    := '';
  576.  MskTime := '00' + sTime + '00' + sTime + '00';
  577.  vTime   := FormatDateTime('hh:mm:ss',Time);
  578.  vMin    := Copy(vTime,4,2);
  579.  vSec    := Copy(vTime,7,2);
  580.  
  581.  // Quitar separadores si los hay
  582.  if Length(Text) > 0 then
  583.   for iLength := 1 to Length(Text) do
  584.    if Text[iLength] in ['0'..'9'] then Temp := Temp + Text[iLength];
  585.  
  586.  // Formatear el tiempo
  587.  iLength := Length(Temp);
  588.  if TimeSeconds then begin // Con segundos
  589.    Case iLength of
  590.     0 : Temp := vTime;
  591.     1 : Temp := '0' + Temp[1] + Copy(MskTime,3,6);
  592.     2 : Temp := Temp + Copy(MskTime,3,6);
  593.     3 : Temp := Copy(Temp,1,2) + sTime + '0' + Temp[3] + Copy(MskTime,6,3);
  594.     4 : Temp := Copy(Temp,1,2) + sTime  + Copy(Temp,3,2) + Copy(MskTime,6,3);
  595.     5 : Temp := Copy(Temp,1,2) + sTime  + Copy(Temp,3,2) + sTime + '0' + Temp[5];
  596.     6,7,8 : Temp := Copy(Temp,1,2) + sTime  + Copy(Temp,3,2) + sTime + Copy(Temp,5,2);
  597.    end;
  598.  end else begin // Sin segundos
  599.    Case iLength of
  600.     0 : Temp := vTime;
  601.     1 : Temp := '0' + Temp[1] + Copy(MskTime,3,3);
  602.     2 : Temp := Temp + Copy(MskTime,3,3);
  603.     3 : Temp := Copy(Temp,1,2) + sTime + '0' + Temp[3];
  604.     4,5 : Temp := Copy(Temp,1,2) + sTime  + Copy(Temp,3,2);
  605.    end;
  606.  end;
  607.  
  608.  // Test of string-time
  609.  try
  610.   tTime := StrToTime(Temp);
  611.  except
  612.   ShowMessage('Time incorrect');
  613.   if TimeSeconds then Text := vTime else Text := Copy(vTime,1,5);
  614.   ValueTime  := Time;
  615.   ValueFloat := ValueTime;
  616.   Exit;
  617.  end;
  618.   // The time is correct
  619.   Text       := Temp;
  620.   ValueTime  := StrToTime(Temp);
  621.   ValueFloat := ValueTime;
  622. end;
  623.  
  624. {***************************************************************************}
  625. constructor TMEditN.Create(AOwner : TComponent);
  626. begin
  627.  inherited Create(AOwner);
  628.  ColorOnFocus        := clWhite;
  629.  ColorOnNotFocus     := clSilver;
  630.  Color               := ColorOnNotFocus;
  631.  FontColorOnFocus    := clRed;
  632.  FontColorOnNotFocus := clBlack;
  633.  FWidthOnFocus       := 0;
  634.  FKeyTab             := #9;
  635. end;
  636.  
  637. procedure TMEditN.KeyPress(var Key: Char);
  638. var
  639.  {$IFDEF VER100}
  640.   FEditTemp : TCustomForm; {For Delphi 3}
  641.  {$ELSE}
  642.   FEditTemp : TForm;       {For Delphi 1 - 2}
  643.  {$ENDIF}
  644. begin
  645.  if Key = EditKeyByTab then begin
  646.   FEditTemp := GetParentForm(Self);
  647.   SendMessage(FEditTemp.Handle, WM_NEXTDLGCTL, 0, 0);
  648.   Key := #0;
  649.  end;
  650.  
  651.  if Key <> #0 then inherited KeyPress(Key);
  652. end;
  653.  
  654. procedure TMEditN.DoEnter;
  655. begin
  656.  // To assign the Color upon receiving the focus
  657.  Color       := ColorOnFocus;
  658.  Font.Color  := FontColorOnFocus;
  659.  if WidthOnFocus > 0 then begin
  660.   iWidth := Width;
  661.   Width  := FWidthOnFocus;
  662.  end;
  663.  
  664.  if Assigned(FOnEnter) then FOnEnter(Self);
  665. end;
  666.  
  667. procedure TMEditN.DoExit;
  668. begin
  669.  // To return the color of the fund upon leaving and losing the focus
  670.  Color      := ColorOnNotFocus;
  671.  Font.Color := FontColorOnNotFocus;
  672.  if WidthOnFocus > 0 then Width := iWidth;
  673.  
  674.  if Assigned(FOnExit) then FOnExit(Self);
  675. end;
  676.  
  677. {***************************************************************************}
  678. constructor TDBEditN.Create(AOwner : TComponent);
  679. begin
  680.   inherited Create(AOwner);
  681.   ColorOnFocus        := clWhite;
  682.   ColorOnNotFocus     := clSilver;
  683.   Color               := ColorOnNotFocus;
  684.   FontColorOnFocus    := clRed;
  685.   FontColorOnNotFocus := clBlack;
  686.   FUpper              := False;
  687.   FUpperList          := ' (';
  688.   FWidthOnFocus       := 0;
  689.   FKeyTab             := #9;
  690. end;
  691.  
  692. procedure TDBEditN.KeyPress(var Key: Char);
  693. var
  694.  {$IFDEF VER100}
  695.   FEditTemp : TCustomForm; {For Delphi 3}
  696.  {$ELSE}
  697.   FEditTemp : TForm;       {For Delphi 1 - 2}
  698.  {$ENDIF}
  699.  c : String;
  700. begin
  701.  if Key = EditKeyByTab then begin
  702.   FEditTemp := GetParentForm(Self);
  703.   SendMessage(FEditTemp.Handle, WM_NEXTDLGCTL, 0, 0);
  704.   Key := #0;
  705.  end;
  706.  
  707.  if FUpper then begin // Capital letter  - Ma²usculas
  708.   if (Length(Text) = 0) or
  709.      (SelText = Text) or
  710.      (Pos(Text[Length(Text)],FUpperList) > 0) then begin
  711.    C   := AnsiUpperCase(Key);
  712.    Key := C[1];
  713.   end;
  714.  end;
  715.  
  716.  if Key <> #0 then inherited KeyPress(Key);
  717. end;
  718.  
  719. procedure TDBEditN.DoEnter;
  720. begin
  721.  // To assign the Color upon receiving the focus
  722.  Color       := ColorOnFocus;
  723.  Font.Color  := FontColorOnFocus;
  724.  if WidthOnFocus > 0 then begin
  725.   iWidth := Width;
  726.   Width  := FWidthOnFocus;
  727.  end;
  728.  
  729.  if Assigned(FOnEnter) then FOnEnter(Self);
  730. end;
  731.  
  732. procedure TDBEditN.DoExit;
  733. begin
  734.  // To return the color of the back upon leaving and losing the focus
  735.  Color      := ColorOnNotFocus;
  736.  Font.Color := FontColorOnNotFocus;
  737.  if WidthOnFocus > 0 then Width := iWidth;
  738.  
  739.  if Assigned(FOnExit) then FOnExit(Self);
  740. end;
  741.  
  742. procedure Register;
  743. begin
  744.   RegisterComponents('Standard', [TEditN]);
  745.   RegisterComponents('Additional', [TMEditN]);
  746.   RegisterComponents('Data Controls', [TDBEditN]);
  747. end;
  748.  
  749. end.
  750.